home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / circletext.pprx < prev    next >
Text File  |  1996-11-02  |  12KB  |  473 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: CircleText.pprx 1.0 */
  4.  
  5. /** ENG
  6.  This script draws a circular vector text.
  7.  
  8.  This is a "tool macro": the mouse can be used to define a circle; when
  9.  the mouse button is released, a settings requester is displayed. The
  10.  settings include: font, text string, text size, antialiasing, etc.
  11.  
  12.  If a single point (pixel) is selected instead of an area, the previous
  13.  circle coordinates remain in use. Other parameters allow the user
  14.  to adjust the appearance of the text.
  15.  
  16.  The text string specified in the settings requester may contain color
  17.  control sequences, in the format "Esc[3#m" or "[#]", where # is a pen
  18.  number (0 .. 256). The default (initial) color is the current foreground
  19.  color.
  20. */
  21.  
  22. /** DEU
  23.  Dieses Skript dient zur Ausrichtung eines Vektortexts an einer
  24.  Kreislinie.
  25.  
  26.  Dies ist ein sog. "Tool-Makro", d.h. zunächst wird mit Hilfe der Maus
  27.  der Kreis erstellt. Sobald die Maustaste losgelassen wird, öffnet
  28.  sich ein Dialogfenster zur Festlegung von Einstellungen für Font,
  29.  Textstring, Zeichengröße, Kantenglättung, usw.
  30.  
  31.  Wird anstelle eine Bereichs lediglich ein einzelner Punkt selektiert,
  32.  bleiben die vorherigen Kreiskoordinaten erhalten. Andere Parameter
  33.  ermöglichen dem Benutzer u.a. die Festlegung des Erscheinungsbildes
  34.  für den Text.
  35.  
  36.  Hinweis: Der im Einstellungen-Dialogfenster festgelegte Textstring kann
  37.  auch mit Steuerzeichen zur Aktivierung einer bestimmten Farbe versehen
  38.  werden. Diese müssen im Format "Esc[3#m]" oder "[#]" vorliegen, wobei das
  39.  Rautenzeichen # die Stiftnummer (0...256) angibt. Standardmäßig ist die
  40.  aktuelle Vordergrundfarbe eingestellt.
  41. */
  42.  
  43. IF ARG(1, EXISTS) THEN
  44.     PARSE ARG PPPORT button x0 y0 .
  45. ELSE
  46.     EXIT 0  /* macro execution only */
  47.  
  48. ADDRESS VALUE PPPORT
  49. OPTIONS RESULTS
  50. OPTIONS FAILAT 10000
  51.  
  52. Get 'LANG'
  53. IF RESULT = 1 THEN DO        /* Deutsch */
  54.     txt_title_zone    = "Kreisdefinition"
  55.     txt_gad_x0        = "Zentrum _X:"
  56.     txt_gad_y0        = "Zentrum _Y:"
  57.     txt_gad_radius    = "_Radius:"
  58.     txt_title_set     = "Kreistext-Einstellungen"
  59.     txt_gad_font      = "_Font:"
  60.     txt_gad_text      = "_Text:"
  61.     txt_string_text   = "Dieser Text verläuft im Kreis. "
  62.     txt_gad_height    = "_Höhe:"
  63.     txt_gad_sangle    = "A_nfangswinkel:"
  64.     txt_gad_aalias    = "_Kantenglättung:"
  65.     txt_gad_aalias0   = "Keine"
  66.     txt_gad_aalias1   = "Schwach"
  67.     txt_gad_aalias2   = "Mittel"
  68.     txt_gad_aalias3   = "Stark"
  69.     txt_err_nofonts   = "Vectorfonts nicht auffindbar"
  70.     txt_err_procss    = "Fehler bei Bildbearbeitung: "
  71.     txt_err_small     = "Kreis ist zu klein"
  72.     txt_err_nomem     = "Zu wenig Speicher"
  73.     txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
  74. END
  75. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  76.     txt_title_zone    = "Definizione cerchio"
  77.     txt_gad_x0        = "Centro _X:"
  78.     txt_gad_y0        = "Centro _Y:"
  79.     txt_gad_radius    = "_Raggio:"
  80.     txt_title_set     = "Parametri testo"
  81.     txt_gad_font      = "_Font:"
  82.     txt_gad_text      = "_Testo:"
  83.     txt_string_text   = "Questo è un testo circolare. "
  84.     txt_gad_height    = "Alte_zza:"
  85.     txt_gad_sangle    = "Ang_olo iniziale:"
  86.     txt_gad_aalias    = "Antialia_s:"
  87.     txt_gad_aalias0   = "Nessuno"
  88.     txt_gad_aalias1   = "Basso"
  89.     txt_gad_aalias2   = "Medio"
  90.     txt_gad_aalias3   = "Alto"
  91.     txt_err_nofonts   = "Non vi sono font vettoriali"
  92.     txt_err_procss    = "Errore elaborazione immagine: "
  93.     txt_err_small     = "Il cerchio definito è troppo piccolo"
  94.     txt_err_nomem     = "Memoria insufficiente"
  95.     txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
  96. END
  97. ELSE DO                /* English */
  98.     txt_title_zone    = "Circle Definition"
  99.     txt_gad_x0        = "Center _X:"
  100.     txt_gad_y0        = "Center _Y:"
  101.     txt_gad_radius    = "_Radius:"
  102.     txt_title_set     = "Circle Text Settings"
  103.     txt_gad_font      = "_Font:"
  104.     txt_gad_text      = "_Text:"
  105.     txt_string_text   = "This is a circular text. "
  106.     txt_gad_height    = "_Height:"
  107.     txt_gad_sangle    = "Start _Angle:"
  108.     txt_gad_aalias    = "A_ntialias:"
  109.     txt_gad_aalias0   = "None"
  110.     txt_gad_aalias1   = "Low"
  111.     txt_gad_aalias2   = "Medium"
  112.     txt_gad_aalias3   = "High"
  113.     txt_err_nofonts   = "Vector fonts not found"
  114.     txt_err_procss    = "Image processing error: "
  115.     txt_err_small     = "The circle is too small"
  116.     txt_err_nomem     = "Not enough memory"
  117.     txt_err_oldclient = "This script requires a newer_version of Personal Paint"
  118. END
  119.  
  120. Version 'REXX'
  121. IF RESULT < 7 THEN DO
  122.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  123.     EXIT 10
  124. END
  125.  
  126. /* Circle Definition */
  127.  
  128. GetCurrentBrush
  129. savebsh = RESULT
  130. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  131.  
  132. prev_xp = x0
  133. prev_yp = y0
  134. drawn = 0
  135.  
  136. DO FOREVER
  137.     GetMousePosition
  138.     PARSE VAR RESULT xp yp .
  139.  
  140.     IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  141.         IF drawn THEN
  142.             Undo
  143.         GetDistance x0 y0 xp yp 'IMAGERATIO'
  144.         radius = RESULT
  145.         DrawCircle x0 y0 'RADIUSX' radius
  146.  
  147.         prev_xp = xp
  148.         prev_yp = yp
  149.         drawn = 1
  150.     END
  151.     ELSE WaitForEvent
  152.  
  153.     GetMouseButton
  154.     IF RESULT ~= button THEN
  155.         LEAVE
  156. END
  157.  
  158. Undo
  159. SetCurrentBrush savebsh
  160.  
  161.  
  162. FreeBrush
  163. IF RC ~= 0 THEN
  164.     EXIT RC
  165.  
  166. /* Setting Requester */
  167.  
  168. def_font_path = "FONTS:"
  169. max_text_size = 8000
  170.  
  171. font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
  172.  
  173.  
  174. ftot = 0
  175. vftfname = 'ENV:PP_VectorFonts'
  176. IF ~OPEN(fexists, vftfname) THEN DO
  177.     ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
  178.     ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
  179.     IF RC = 0 THEN DO
  180.         ADDRESS COMMAND 'Delete >NIL: 'vftfname
  181.         ADDRESS COMMAND 'Rename >NIL: 'vftfname'.s' vftfname
  182.     END
  183. END
  184. ELSE CALL CLOSE(fexists)
  185.  
  186. IF OPEN('listfile', vftfname) THEN DO
  187.     DO FOREVER
  188.         fline = READLN('listfile')
  189.         IF EOF('listfile') THEN BREAK
  190.         ftot = ftot + 1
  191.         fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
  192.     END
  193.     CALL CLOSE('listfile')
  194. END
  195.  
  196. IF ftot = 0 THEN DO
  197.     RequestNotify 'PROMPT "'txt_err_nofonts'"'
  198.     EXIT 10
  199. END
  200.  
  201.  
  202. IF radius < 2 THEN DO        /* simple click */
  203.     lastpar  = LoadSet('LastParams', '0 0 100')
  204.     PARSE VAR lastpar x0 y0 radius .
  205.     Request '"'txt_title_zone'" ' ||,
  206.             '"INTSTR = ""'txt_gad_x0'"", 0, 32000, 'x0' ' ||,
  207.              'INTSTR = ""'txt_gad_y0'"", 0, 32000, 'y0' ' ||,
  208.              'INTSTR = ""'txt_gad_radius'"", 1, 32000, 'radius' "'
  209.     IF RC ~= 0 THEN
  210.         EXIT RC
  211.     x0 = RESULT.1
  212.     y0 = RESULT.2
  213.     radius = RESULT.3
  214. END
  215.  
  216.  
  217. fntnum  = LoadSet('Font', 0)
  218. text    = LoadSet('Text', txt_string_text)
  219. height  = LoadSet('Height', 50)
  220. angle   = LoadSet('StartAngle', 0)
  221. aalias  = LoadSet('Antialias', 0)
  222. last_height  = height
  223.  
  224. req = '"LIST = ""'txt_gad_font'"", 'ftot', 'fntnum', 20, 10'
  225. DO f = 1 TO ftot
  226.     req = req || ', ""' || fontname.f || '""'
  227. END
  228.  
  229. req = req ||,
  230.      ' VSPACE = 2 ' ||,
  231.       'STRING = ""'txt_gad_text'"", 'max_text_size', ""'text'"" ' ||,
  232.       'INTSTR = ""'txt_gad_height'"", 1, 32000, 'height' ' ||,
  233.       'VSPACE = 2 ' ||,
  234.       'SLIDE = ""'txt_gad_sangle'"", -360, 360, 'angle' ' ||,
  235.       'VSPACE = 2 ' ||,
  236.         'CYCLE = ""'txt_gad_aalias'"", 4, 'aalias', ""'txt_gad_aalias0'"", ""'txt_gad_aalias1'"", ""'txt_gad_aalias2'"", ""'txt_gad_aalias3'"" ' ||,
  237.       'VSPACE = 2 "'
  238.  
  239. LockGUI
  240. Request 'RESIZE COMPACT "'txt_title_set'" 'req
  241. IF RC = 0 THEN DO
  242.     fntnum  = RESULT.1 + 1
  243.     text    = RESULT.2
  244.     height  = RESULT.3
  245.     angle   = RESULT.4
  246.     aalias  = RESULT.5
  247.  
  248.     CALL SaveSet('Font', fntnum - 1)        /* setting persistence */
  249.     CALL SaveSet('Text', text)
  250.     CALL SaveSet('Height', height)
  251.     CALL SaveSet('StartAngle', angle)
  252.     CALL SaveSet('Antialias', aalias)
  253.     CALL SaveSet('LastParams', x0 y0 radius)
  254.  
  255.     IF radius < 1 THEN DO
  256.         RequestNotify 'PROMPT "'txt_err_small'"'
  257.         len = 0
  258.     END
  259.  
  260.     angle = angle * 1000
  261.     IF angle < 0 THEN
  262.         angle = 360000 + angle
  263.     IF angle >= 360000 THEN
  264.         angle = angle - 360000
  265.  
  266.     GetPen 'FOREGROUND'
  267.     pen = RESULT
  268.     savepen = pen
  269.     SIGNAL ON Break_C
  270.  
  271.     tchar. = ''
  272.     tpen. = pen
  273.     tchars = ''
  274.     len = ParseText(text, pen)
  275.     totsize = 0
  276.  
  277.     last_metrics = LoadSet('Metrics', '')
  278.     last_tchars = LoadSet('TxChars', '')
  279.  
  280.     IF height == last_height & tchars == last_tchars THEN DO
  281.         DO c = 1 TO len
  282.             addx = WORD(last_metrics, c)
  283.             totsize = totsize + addx
  284.             size.c = addx
  285.         END
  286.     END
  287.     ELSE DO
  288.         metrics = ''
  289.         DO c = 1 TO len
  290.             nextc = c + 1
  291.             VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height
  292.             IF RC = 0 THEN DO
  293.                 PARSE VAR RESULT addx .
  294.                 totsize = totsize + addx
  295.                 size.c = addx
  296.                 metrics = metrics addx
  297.             END
  298.             ELSE DO
  299.                 RequestNotify 'PROMPT "'txt_err_nomem'"'
  300.                 EXIT 0
  301.             END
  302.         END
  303.         CALL SaveSet('Metrics', metrics)
  304.         CALL SaveSet('TxChars', tchars)
  305.     END
  306.     last = len + 1
  307.     size.last = 0
  308.  
  309.     GetImageAttributes 'DPIX'
  310.     dpix = RESULT
  311.     GetImageAttributes 'DPIY'
  312.     imgratio = dpix / RESULT
  313.     rx = radius
  314.     ry = TRUNC(radius / imgratio + 0.5)
  315.  
  316.     DO c = 1 TO len
  317.         GetEllipsePoint x0 y0 rx ry angle
  318.         PARSE VAR RESULT px py .
  319.  
  320.         nextc = c + 1
  321.         VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height' ANGLE 'angle' ANTIALIAS 'aalias
  322.         IF RC = 0 THEN DO
  323.             PARSE VAR RESULT . . handlex handley .
  324.  
  325.             SetBrushAttributes 'HANDLEX 'handlex' HANDLEY 'handley
  326.             SetPaintMode 'COLOR'
  327.             SetPen 'FOREGROUND' tpen.c
  328.  
  329.             IF aalias > 0 THEN DO
  330.                 Process 'IMAGE BRUSHMODE X0 'px' Y0 'py' FILTER "Brush Alpha Channel (Single)" NOFS'
  331.                 IF RC ~= 0 THEN DO
  332.                     IF RC ~= 5 THEN
  333.                         RequestNotify 'PROMPT "'txt_err_procss || RC'"'
  334.                     LEAVE
  335.                 END
  336.             END
  337.             ELSE PutBrush px py
  338.  
  339.             angle = angle + TRUNC((size.c + size.nextc) / 2 / totsize * 360000 + 0.5)
  340.             IF angle >= 360000 THEN
  341.                 angle = angle - 360000
  342.         END
  343.     END
  344.     SetPen 'FOREGROUND' savepen
  345.     FreeBrush 'FORCE'
  346. END
  347. UnlockGUI
  348.  
  349. EXIT 0
  350.  
  351.  
  352.  
  353.  
  354. ParseText: PROCEDURE EXPOSE tchar. tpen. tchars
  355.  
  356.     tstring = ARG(1)
  357.     tpn = ARG(2)
  358.     tlen = LENGTH(tstring)
  359.     tchars = ''
  360.     tpos = 1
  361.     tnum = 0
  362.  
  363.     DO UNTIL tpos > tlen
  364.         td = SUBSTR(tstring, tpos, 1)
  365.         tnewpen = ''
  366.         IF td = '[' THEN DO    /* [###] */
  367.             tnewpos = tpos + 1
  368.             IF SUBSTR(tstring, tnewpos, 1) = '[' THEN
  369.                 tpos = tpos + 1
  370.             ELSE DO
  371.                 DO FOREVER
  372.                     tc = SUBSTR(tstring, tnewpos, 1)
  373.                     IF tc < '0' | tc > '9' THEN
  374.                         LEAVE
  375.                     tnewpen = tnewpen || tc
  376.                     tnewpos = tnewpos + 1
  377.                 END
  378.             END
  379.         END
  380.         ELSE IF C2D(td) = 27 THEN DO    /* Esc[3###m */
  381.             IF SUBSTR(tstring, tpos+1, 2) == '[3' THEN DO
  382.                 tnewpos = tpos + 3
  383.                 DO FOREVER
  384.                     tc = SUBSTR(tstring, tnewpos, 1)
  385.                     IF tc < '0' | tc > '9' THEN
  386.                         LEAVE
  387.                     tnewpen = tnewpen || tc
  388.                     tnewpos = tnewpos + 1
  389.                 END
  390.             END
  391.         END
  392.         ELSE IF td = '"' THEN
  393.             td = '""'
  394.  
  395.         IF tnewpen == '' THEN DO
  396.             tnum = tnum + 1
  397.             tchar.tnum = td
  398.             tpen.tnum = tpn
  399.             tchars = tchars || td
  400.             tpos = tpos + 1
  401.         END
  402.         ELSE DO
  403.             tpn = tnewpen
  404.             tpos = tnewpos + 1
  405.         END
  406.     END
  407.  
  408.     RETURN tnum
  409.  
  410.  
  411.  
  412.  
  413. SaveSet: PROCEDURE
  414.     sname = ARG(1)
  415.     val = ARG(2)
  416.  
  417.     IF OPEN('settingfile', 'ENV:PP_CircleTx_'sname, 'W') THEN DO
  418.         CALL WRITECH('settingfile', val)
  419.         CALL CLOSE('settingfile')
  420.     END
  421.  
  422.     RETURN
  423.  
  424.  
  425.  
  426.  
  427. LoadSet: PROCEDURE
  428.     sname = ARG(1)
  429.     def_val = ARG(2)
  430.     IF ARG() > 2 THEN
  431.         global_set = ARG(3)
  432.     ELSE
  433.         global_set = 0
  434.     IF ARG() > 3 THEN
  435.         request_quote = ARG(4)
  436.     ELSE
  437.         request_quote = 1
  438.  
  439.     val = def_val
  440.     IF global_set THEN
  441.         set_fname = 'ENV:'sname
  442.     ELSE
  443.         set_fname = 'ENV:PP_CircleTx_'sname
  444.  
  445.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  446.         val = READCH('settingfile', 65535)
  447.         CALL CLOSE('settingfile')
  448.     END
  449.  
  450.     IF request_quote THEN DO
  451.         /* encode quotes for the Request command ('"' -> '\""') */
  452.         qpos_start = 1
  453.         DO FOREVER
  454.             qpos = INDEX(val, '"', qpos_start)
  455.             IF qpos = 0 THEN BREAK
  456.             val = INSERT('\"', val, qpos-1)
  457.             qpos_start = qpos + 3
  458.         END
  459.     END
  460.  
  461.     RETURN val
  462.  
  463.  
  464.  
  465.  
  466. Break_C:
  467.  
  468.     SetPen 'FOREGROUND' savepen
  469.     FreeBrush 'FORCE'
  470.     UnlockGUI
  471.  
  472.     RETURN
  473.